;; create at 2010-10-17 10:55:44

;; test code here

(defvar ytags-overlays nil)

(make-variable-buffer-local 'ytags-overlays)

(defun ytags-mark-current-file ()
  (interactive)
  (let ((filename (file-truename (buffer-file-name)))
        (target-buffer (current-buffer))
        (tag-buffer (get-buffer-create "*ytags*"))
        (tags))

    ;; clear overlays belong to buffer
    (when ytags-overlays
      (mapcar 'delete-overlay ytags-overlays)
      (setq ytags-overlays nil))

    (when filename
      (with-current-buffer tag-buffer
        ;; clear the tag buffer
        (delete-region (point-min) (point-max))

        ;; call the process to eval the tags
        (call-process "ytags_cpp" nil t nil filename)

        (goto-char (point-min))
        (while (re-search-forward
                "\\([0-9]+\\)[ \t]+\\([_a-zA-Z][_a-zA-Z0-9]*\\)[ \t]+\\(.*\\)\n"
                nil t)
          ;; push the tag to tags
          (push (list (match-string 2)
                      (string-to-int (match-string 1))
                      (match-string 3))
                tags)))
      ;; create overlays to mark tags
      (save-excursion
        (mapcar
         (lambda (tag)
           (let ((tag-name (car tag))
                 (lineno (nth 1 tag))
                 (type (nth 2 tag))
                 (ov))
             (goto-line lineno)
             (when (re-search-forward
                    (concat "\\_<" (regexp-quote tag-name) "\\_>") nil t)
               (setq ov (make-overlay (match-beginning 0) (match-end 0)))
               (if (string-equal type "reference")
                   (overlay-put ov 'face '(:background "dark cyan"))
                 (overlay-put ov 'face '(:background "blue")))
               (overlay-put ov 'help-echo type)
               (push ov ytags-overlays))))
         tags)))))

;; code begin here

(defvar ytags-mode nil
  "Non-nil if Gtags mode is enabled.")

(make-variable-buffer-local 'ytags-mode)

(defvar ytags-mode-map (make-sparse-keymap)
  "Keymap used in gtags mode.")

(defvar ytags-db-dir nil
  "the path of tag database")

;; marker buffer-name file-name
(defvar ytags-jmp-hist nil
  "save the jump history file list")

(defun ytags-jmp-prev ()
  (interactive)
  (if (not ytags-jmp-hist)
      (message "jump stack is empty")
    (let ((item) (marker) (bn) (fn) (buffer))
      (setq item (car ytags-jmp-hist))
      (setq ytags-jmp-hist (cdr ytags-jmp-hist))
      (setq marker (car item)
            bn (nth 1 item)
            fn (nth 2 item))
      (setq buffer (get-buffer bn))
      (if buffer
          (progn
            (switch-to-buffer buffer)
            (goto-char marker))
        ;; check the file whether exists
        (cond
         (fn
          (if (not (file-exists-p fn))
            (message "file `%s' doesn't exists" fn)
          (find-file fn)))
         (t
          (message "message buffer `%s' has closed" bn)))))))

(defun ytags-jmp-save ()
  (push (list (set-marker (make-marker) (point))
              (buffer-name)
              (when (buffer-file-name)
                (file-truename (buffer-file-name))))
        ytags-jmp-hist))

(defun ytags-find-db-dir (&optional fn)
  "call ytags --find-db-dir to get the directory"
  (with-temp-buffer
    (if (stringp fn)
        (call-process "ytags" nil t nil "--find-db-dir" fn)
      (call-process "ytags" nil t nil "--find-db-dir"))
    (when (= 1 (count-lines (point-min) (point-max)))
      (goto-char (point-min))
      (setq ytags-db-dir (buffer-substring-no-properties
                          (line-beginning-position)
                          (line-end-position))))))

;; if ytags-db-root is nil
;; call ytags to guess the path is.
(defun ytags-set-db-dir (path)
  (interactive "Ddirectory that ytags database store: ")
  (setq ytags-db-dir (expand-file-name path)))

;; when ytags return non-zero code
;; ytags-find-def return a string "error"
(defun ytags-find-def (tag)
  (with-temp-buffer
    (let ((tags nil))
      (if (= 0 (if ytags-db-dir
                   (call-process "ytags" nil t nil
                                 "--query" "--db-dir" ytags-db-dir
                                 "-d" tag)
                 (call-process "ytags" nil t nil "--query"
                               "-d" tag)))
          (progn
            (goto-char (point-min))
            (while (re-search-forward
                    ;; lineno       name    type    filename\n
                    "\\([0-9]+\\)\t\\(.+\\)\t\\([_a-zA-Z][_a-zA-Z0-9]*\\)\t\\(.+\\)\n"
                    nil t)
              (push (list (string-to-int (match-string 1))
                          (match-string 2)
                          (match-string 3)
                          (match-string 4))
                    tags))
            (reverse tags))
        ;; when the ytags return non-zero
        ;; show the error message to user.
        (message "ytags error with: %s"
                 (if (> (point-max) 0)
                     (buffer-substring-no-properties (point-min) (point-max))
                   "[NULL]"))
        "error"))))

(defun ytags-find-ref (tag)
  (with-temp-buffer
    (let ((tags nil))
      (if (= 0 (if ytags-db-dir
                   (call-process "ytags" nil t nil
                                 "--query" "--db-dir" ytags-db-dir
                                 "-r" tag)
                 (call-process "ytags" nil t nil "--query"
                               "-r" tag)))
          (progn
            (goto-char (point-min))
            (while (re-search-forward
                    ;; lineno       name    filename\n
                    "\\([0-9]+\\)\t\\(.+\\)\t\\(.+\\)\n"
                    nil t)
              (push (list (string-to-int (match-string 1))
                          (match-string 2)
                          (match-string 3))
                    tags))
            (reverse tags))
        ;; when the ytags return non-zero
        ;; show the error message to user.
        (message "ytags error with: %s"
                 (if (> (point-max) 0)
                     (buffer-substring-no-properties (point-min) (point-max))
                   "[NULL]"))
        "error"))))

(defun ytags-current-symbol ()
  (let (bound)
    (setq bound (bounds-of-thing-at-point 'symbol))
    (when bound
      (buffer-substring-no-properties (car bound)
                                      (cdr bound)))))

(defun ytags-buffer-select-file-cur ()
  (interactive)
  (goto-char (line-beginning-position))
  (when (re-search-forward
         "\t\\(.+\\):\\([0-9]+\\)\n" nil t)
    (let ((fn (match-string-no-properties 1))
          (ln (string-to-int (match-string-no-properties 2))))
      (find-file fn)
      (goto-line ln))))

(defun ytags-buffer-select-file (event)
  (interactive "e")
  (ytags-goto-event-point event)
  (ytags-buffer-select-file-cur))

(defun ytags-disp-select-buffer (multi-res tag-type)
  (let ((lineno) (name) (type) (filename) (pt))
    (switch-to-buffer (get-buffer-create "*ytags*"))
    (delete-region (point-min) (point-max))
    (cond
     ((eq tag-type 'def)
      ;; tag def
      (dolist (item multi-res)
        (setq lineno    (car item)
              name      (nth 1 item)
              type      (nth 2 item)
              filename  (nth 3 item)
              pt        (point))
        ;; name:type    filename:lineno
        (insert
         (propertize (format "%s:%s\t%s:%d\n" name type filename lineno)
                     'face '(:foreground "green")))
        (add-text-properties pt (1- (point))
                             '(mouse-face underline))))
     ((eq tag-type 'ref)
      ;; tag ref
      (dolist (item multi-res)
        (setq lineno    (car item)
              name      (nth 1 item)
              filename  (nth 2 item)
              pt        (point))
        ;; name:type    filename:lineno
        (insert
         (propertize (format "%s\t%s:%d\n" name filename lineno)
                     'face '(:foreground "green")))
        (add-text-properties pt (1- (point))
                             '(mouse-face underline))))
     (t
      (message "bug, type is %s" (symbol-name type))))
    (goto-char (point-min))
    (local-set-key [(control mouse-1)] 'ytags-buffer-select-file)
    (local-set-key [(down-mouse-1)] (lambda () (interactive) t))
    (local-set-key [(mouse-1)] 'ytags-buffer-select-file)
    (local-set-key [return] 'ytags-buffer-select-file-cur)
    (local-set-key [(control mouse-3)] 'ytags-jmp-prev)
    (local-set-key [(down-mouse-3)] (lambda () (interactive) t))
    (local-set-key [(mouse-3)] 'ytags-jmp-prev)))

(defun ytags-goto-event-point (event)
  (select-window (posn-window (event-end event)))
  (set-buffer (window-buffer (posn-window (event-end event))))
  (goto-char (posn-point (event-end event))))

(defun ytags-find-def-by-event ()
  (interactive)
  (let ((tag (ytags-current-symbol))
        (res))
    (when tag
      (setq res (ytags-find-def tag))
      ;; tell the user tag not found
      (cond
       ((and res (listp res))
        (if (= (length res) 1)
            ;; jump no choice
            (progn
              (setq res (car res))
              (let ((lineno (car res))
                    (fn (nth 3 res)))
                (if (not (file-exists-p fn))
                    (message "file `%s' doesn't exists" fn)
                  ;; if the tag finding is the current one
                  ;; do nothing
                  (if (and (buffer-file-name)
                           (string-equal (file-truename (buffer-file-name)) fn)
                           (= lineno (line-number-at-pos)))
                      (message "tag `%s' is current" tag)
                    ;; save the position
                    (ytags-jmp-save)
                    (find-file fn)
                    (goto-line lineno)))))
          (message "got %d tags, select one" (length res))
          (ytags-jmp-save)
          (ytags-disp-select-buffer res 'def)))
       ((not res)
        (message "can't found tag `%s'" tag))))))

(defun ytags-find-def-by-event-mouse (event)
  (interactive "e")
  (ytags-goto-event-point event)
  (ytags-find-def-by-event))

(defun ytags-find-ref-by-event ()
  (interactive)
  (let ((tag (ytags-current-symbol))
        (res))
    (when tag
      (setq res (ytags-find-ref tag))
      ;; tell the user tag not found
      (cond
       ((and res (listp res))
        (if (= (length res) 1)
            ;; jump no choice
            (progn
              (setq res (car res))
              (let ((lineno (car res))
                    (fn (nth 2 res)))
                (if (not (file-exists-p fn))
                    (message "file `%s' doesn't exists" fn)
                  ;; if the tag finding is the current one
                  ;; do nothing
                  (if (and (buffer-file-name)
                           (string-equal (file-truename (buffer-file-name)) fn)
                           (= lineno (line-number-at-pos)))
                      (message "tag `%s' is current" tag)
                    ;; save the position
                    (ytags-jmp-save)
                    (find-file fn)
                    (goto-line lineno)))))
          (message "got %d tags, select one" (length res))
          (ytags-jmp-save)
          (ytags-disp-select-buffer res 'ref)))
       ((not res)
        (message "can't found tag `%s'" tag))))))

(defun ytags-find-ref-by-event-mouse (event)
  (interactive "e")
  (ytags-goto-event-point event)
  (ytags-find-ref-by-event))

(defun ytags-update-current-file ()
  (when (and (buffer-file-name)
             (or (eq major-mode 'c++-mode)
                 (eq major-mode 'c-mode)
                 (eq major-mode 'emacs-lisp-mode)
                 (eq major-mode 'lua-mode)
                 (eq major-mode 'python-mode)))
    (let ((fn (file-truename (buffer-file-name))))
      (with-temp-buffer
        (if (= 0 (if ytags-db-dir
                     (call-process "ytags" nil t nil
                                   "--update" "--db-dir" ytags-db-dir fn)
                   (call-process "ytags" nil t nil "--update" fn)))
            (message "update `%s' tag done" fn)
          (message "update `%s' tag failed: " fn
                   (buffer-substring-no-properties
                    (point-min) (point-max))))))))

(define-key ytags-mode-map [(control mouse-3)] 'ytags-jmp-prev)
(define-key ytags-mode-map [(control mouse-1)] 'ytags-find-def-by-event-mouse)
(define-key ytags-mode-map [?\e mouse-1] 'ytags-find-ref-by-event-mouse)

;; 创建一个前缀 map
(setq my-meta-y-map (make-sparse-keymap))

(define-key ytags-mode-map "\M-y" my-meta-y-map)
(define-key ytags-mode-map "\M-y\M-d" 'ytags-find-def-by-event)
(define-key ytags-mode-map "\M-y\M-f" 'ytags-find-ref-by-event)
(define-key ytags-mode-map "\M-y\M-b" 'ytags-jmp-prev)

;;;###autoload
(defun ytags-mode (&optional forces)
  (interactive)
  (or (assq 'ytags-mode minor-mode-alist)
      (setq minor-mode-alist (cons '(ytags-mode " ytags") minor-mode-alist)))
  (or (assq 'ytags-mode minor-mode-map-alist)
      (setq minor-mode-map-alist
            (cons (cons 'ytags-mode ytags-mode-map) minor-mode-map-alist)))
  (setq ytags-mode
        (if (null forces) (not ytags-mode)
          (> (prefix-numeric-value forces) 0)))
  (run-hooks 'ytags-mode-hook))

(provide 'ytags)
